Исходный текст

Option Explicit
Call ExportStatusesInfo()


'==============================================================================
' Вывести краткую информацию о типах статусов в MSExcel 
'==============================================================================
Sub ExportStatusesInfo()

        On Error Resume Next
        Err = 0    
        
        Dim ExcelApp, WrkBook, AllStatCol, Stat, List, s, i

        'Открыть приложение Excel
        Set ExcelApp = CreateObject("Excel.Application")
        If Err <> 0 Then 'Ошибка открытия ...
                MsgBox "Невозможно открыть приложение MS Excel.",  vbInformation, "ошибка MS Excel" 
                Exit Sub
        End If
                            
        ' Добавить рабочую книгу
        Set WrkBook = ExcelApp.Workbooks.Add
        Set List = WrkBook.ActiveSheet
    
        'Вывести на текущий лист описания всех статусов и прав доступа по ним
        i = 2
        Set AllStatCol = ThisApplication.Statuses ' Получить коллекцию статусов
        For Each Stat In AllStatCol
                'В первый столбец вывести описание статуса
                List.Cells(i, 1) = Stat.Description
                'Во второй столбец вывести разрешенные по статусу действия
                With Stat.Permissions
                        'Если значение св-ва объекта Permissions не установлено в "Запрещено" (tdmDeny),
                        'то право по статусу на соотв. действие над объектом есть 
                        If .View <> tdmDeny Then s = "Просмотр объекта; " 
                        If .ViewFiles <> tdmDeny Then s = s & "Просмотр файлов; "
                        If .RestrictedViewFiles <> tdmDeny Then s = s & "Ограниченный просмотр файлов; "
                        If .Edit <> tdmDeny Then s = s & "Редактирование атрибутов; "
                        If .EditContent <> tdmDeny Then s = s & "Редактирование состава; "
                        If .EditFiles <> tdmDeny Then s = s & "Редактирование файлов; "
                        If .CreateVersion <> tdmDeny Then s = s & "Создание версий; "
                        If .Erase <> tdmDeny Then s = s & "Удаление объекта"
                End With
                List.Cells(i, 2) = s
                i = i + 1
        Next
        
        'Отформатировать шапку таблицы
        List.Cells(1,1) = "Статус"            
        List.Cells(1,2) =     "Разрешения по статусу"
        List.Rows(1).Font.Size = 12
        List.Rows(1).Font.Bold = TRUE
        List.Columns.AutoFit
        
        'Показать окно Excel
        ExcelApp.Application.Visible = TRUE
End Sub 
'==============================================================================